      SUBROUTINE SETUP
      RETURN
      END
      BLOCK DATA
      INCLUDE 'BLOCO.INC'
      INTEGER I,J
      DATA NAME/'HS97XMOD'/
      DATA X/NX*0.005D0/
      DATA N/ 6/ , NH/0/ , NG/16/
      DATA DEL0/1.0D-3/ ,TAU0/1.0D0/ ,TAU/.1D0/
      DATA ((GUNIT(I,J),I=1,3),J=0,4)/-1,0,0,-1,0,0,-1,0,0,-1,0,0,
     F     -1,0,0/,(GUNIT(1,I),I=5,16)/12*1/,(GUNIT(2,I),I=5,16)/
     F      1,2,3,4,5,6,1,2,3,4,5,6/,(GUNIT(3,I),I=5,16)/6*1,6*-1/
      END
      SUBROUTINE EF(X,FX)
      INCLUDE 'FUCO.INC'
      INTEGER J
      DOUBLE PRECISION X(NX),A( 6),FX,S
      SAVE A
      DATA  A/4.3D0,31.8D0,63.3D0,15.8D0,68.5D0,4.7D0/
      ICF=ICF+1
      S=0.D0
      DO      100      J=1,6
      S=S+A(J)*X(J)
  100 CONTINUE
      FX=S
      RETURN
      END
      SUBROUTINE EGRADF(X,GRADF)
      INCLUDE 'FUCO.INC'
      INTEGER J
      DOUBLE PRECISION X(NX),GRADF(NX),A( 6)
      SAVE A
      DATA  A/4.3D0,31.8D0,63.3D0,15.8D0,68.5D0,4.7D0/
      ICGF=ICGF+1
      DO      100      J=1,6
      GRADF(J)= A(J)
 100  CONTINUE
      RETURN
      END
      SUBROUTINE EH(I,X,HXI)
      INCLUDE 'FUCO.INC'
      INTEGER I
      DOUBLE PRECISION X(NX),HXI
      CRES(I)=CRES(I)+1
      RETURN
      END
      SUBROUTINE EGRADH(I,X,GRADHI)
      INCLUDE 'FUCO.INC'
      INTEGER I
      DOUBLE PRECISION X(NX),GRADHI(NX)
      CGRES(I)=CGRES(I)+1
      RETURN
      END
      SUBROUTINE EG(I,X,GXI)
      INCLUDE 'FUCO.INC'
      INTEGER I,J
      DOUBLE PRECISION X(NX),B(6,4),C(4),OG(6),S,GXI
      SAVE B,C,OG
      DATA B/17.1D0,38.2D0,204.2D0,212.3D0,623.4D0,1495.5D0,
     1       17.9D0,36.8D0,113.9D0,169.7D0,337.8D0,1385.2D0,
     2        0.0D0,-273.D0,0.D0,-70.D0,-819.D0,0.D0,
     3      159.9D0,-311.D0,0.D0,587.D0, 391.D0,2198.D0/
      DATA C/32.97D0,25.12D0,-29.08D0,-78.02D0/
      DATA OG/.31D0,.046D0,.068D0,.042D0,.028D0,.0134D0/
      IF ( I .LE. 4 ) CRES(I+NH)=CRES(I+NH)+1
      IF(I .GT. 4)      GOTO 600
      S=0.D0
      DO      100      J=1,6
      S=S+B(J,I)*X(J)
 100  CONTINUE
      S=S-C(I)
      GOTO (200,300,400,500),I
  200 CONTINUE
       S=S-(169.D0*X(1)*X(3)+185.D2 *X(4)*X(6)+X(5)*(358.D1*X(3)+
     1     381.D1*X(4)+243.D2*X(6)))
      GXI=S
      RETURN
  300 CONTINUE
       S=S-(139.D0*X(1)*X(3)+245.D1 *X(4)*X(5)+X(6)*(166.D2*X(4)+
     1     172.D2*X(5)))
      GXI=S
      RETURN
  400 CONTINUE
      S=S+26.D3*X(4)*X(5)
      GXI=S
      RETURN
  500 CONTINUE
      S=S-14.D3*X(1)*X(6)
      GXI=S
      RETURN
  600 CONTINUE
      IF(I .GT. 10)     GXI=OG(I-10)-X(I-10)
      IF(I .LE. 10)     GXI=X(I- 4)
      RETURN
      END
      SUBROUTINE EGRADG(I,X,GRADGI)
      INCLUDE 'FUCO.INC'
      INTEGER I,J
      DOUBLE PRECISION X(NX),GRADGI(NX),B( 6,4)
      SAVE B
      DATA B/17.1D0,38.2D0,204.2D0,212.3D0,623.4D0,1495.5D0,
     1       17.9D0,36.8D0,113.9D0,169.7D0,337.8D0,1385.2D0,
     2        0.0D0,-273.D0,0.D0,-70.D0,-819.D0,0.D0,
     3      159.9D0,-311.D0,0.D0,587.D0, 391.D0,2198.D0/
      IF(I .GT. 4)    RETURN
      CGRES(I+NH)=CGRES(I+NH)+1
      DO     100      J=1,6
      GRADGI(J)=B(J,I)
  100 CONTINUE
      GOTO (200,300,400,500),I
  200 CONTINUE
      GRADGI(1)=GRADGI(1)-169.D0*X(3)
      GRADGI(3)=GRADGI(3)-169.D0*X(1)-358.D1*X(5)
      GRADGI(4)=GRADGI(4)-381.D1*X(5)-185.D2*X(6)
      GRADGI(5)=GRADGI(5)-358.D1*X(3)-381.D1*X(4)-243.D2*X(6)
      GRADGI(6)=GRADGI(6)-185.D2*X(4)-243.D2*X(5)
      RETURN
  300 CONTINUE
      GRADGI(1)=GRADGI(1)-139.D0*X(3)
      GRADGI(3)=GRADGI(3)-139.D0*X(1)
      GRADGI(4)=GRADGI(4)-245.D1*X(5)-166.D2*X(6)
      GRADGI(5)=GRADGI(5)-245.D1*X(4)-172.D2*X(6)
      GRADGI(6)=GRADGI(6)-166.D2*X(4)-172.D2*X(5)
      RETURN
  400 CONTINUE
      GRADGI(4)=GRADGI(4)+260.D2*X(5)
      GRADGI(5)=GRADGI(5)+260.D2*X(4)
      RETURN
  500 CONTINUE
      GRADGI(1)=GRADGI(1)-14.D3*X(6)
      GRADGI(6)=GRADGI(6)-14.D3*X(1)
      RETURN
      END
